home *** CD-ROM | disk | FTP | other *** search
/ Aminet 39 / Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso / Aminet / biz / swood / FW_AllInOne.lha / Makros / FontCode.long < prev    next >
Text File  |  1998-01-17  |  5KB  |  167 lines
  1. /****************************************
  2. *  FontCode für FW 3+                   *
  3. *  $VER: 3.0 © Heiko Schröder 04.01.98  *
  4. *****************************************/
  5.  
  6. /* neu: auslesen eines Codes */
  7.  
  8. Parse ARG FW
  9.  
  10. if ~show('L',"rexxreqtools.library") then
  11.    if ~addlib('rexxreqtools.library',0,-30,0) then do
  12.       'ShowMessage 1 1 "Fehler...." "Benötige Libs:rexxreqtools.library" " A B B R U C H ! !" "Okay" "" ""'
  13.        exit
  14.    end
  15. IF ~SHOW('L','tritonrexx.library') THEN
  16.    IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN DO
  17.       'ShowMessage 2 1 "Fehler...." "Benötige Libs:tritonrexx.library" "" "Abbruch" "" ""'
  18.       exit
  19.    END
  20.  
  21. R='0A'X
  22.  
  23. If FW='' then do
  24.    Address='FinalW'
  25.    Options results
  26.  
  27.    STATUS PORTNAME
  28.    FW = result
  29. End
  30.    address(FW)
  31.  
  32. SIGNAL ON SYNTAX
  33.  
  34. If open('Hilfe',"S:FW_Paket.prefs","R") then do
  35.    HilfeVerz=readln('Hilfe')
  36.    Call Close('Hilfe')
  37. End
  38. else HilfeVerz=''
  39.  
  40. apptags = 'TRCA_Name     FontCode',
  41.           'TRCA_LongName "FontCode"',
  42.           'TRCA_Info     "Makro für Finalwriter"',
  43.           'TRCA_Version  "3.0 registered"',
  44.           'TRCA_Release  "3"',
  45.           'TRCA_Date     "04.01.98"',
  46.           'TAG_END'
  47.  
  48. windowtags = WindowID(1),
  49.              WindowPosition('TRWP_CENTERDISPLAY'),
  50.              WindowFlags('TRWF_ACTIVATESTRGAD|TRWF_NOSIZEGADGET'),
  51.              PubScreenName('FinalWriterPubScreen'),
  52.              WindowTitle('FontCode'),
  53.              BeginMenu('Projekt'),
  54.                 MenuItem('Q_Verlassen...',104),
  55.              BeginMenu('?'),
  56.                 MenuItem('?_Info',101),
  57.                 MenuItem('H_Hilfe',103),
  58.              'HorizGroupAC',
  59.                 'SpaceS',
  60.                 'VertGroupAC',
  61.                    'SpaceS',
  62.                    'HorizGroupEC',
  63.                       CheckBox(3),
  64.                       'SpaceS',
  65.                       StringGadget('',10),
  66.                    'EndGroup',
  67.                    'SpaceS',
  68.                    'HorizGroupEC',
  69.                       Button('_Anwenden',2),
  70.                       'SpaceS',
  71.                       Button('Ab_bruch',4),
  72.                    'EndGroup',
  73.                 'SpaceS',
  74.                 'EndGroup',
  75.                 'SpaceS',
  76.              'EndGroup',
  77.           'EndProject'
  78.  
  79. app = TR_CREATEAPP('TRCA_Name FontCode')
  80. IF app ~= '00000000'x THEN DO
  81.    ende=0
  82.    window1 = TR_OPENPROJECT(app,windowtags)
  83.    IF window1 ~= '00000000'x THEN DO
  84.       DO WHILE ende ~= 1
  85.          CALL TR_WAIT(app,'')
  86.  
  87.          DO WHILE TR_HANDLEMSG(app,'event')
  88.             IF event.trm_class = 'TRMS_NEWVALUE' THEN DO
  89.                SELECT
  90.                   WHEN event.trm_id = 3 THEN Do
  91.                      Extract
  92.                      a = c2d(result)
  93.                      CALL TR_SETATTRIBUTE(window1,10,'TROB_STRING',a)
  94.                      CALL TR_SETATTRIBUTE(window1, 3,'TRAT_VALUE',0)
  95.                   END
  96.  
  97.                   WHEN event.trm_id = 10 THEN Call Write
  98.  
  99.                   OTHERWISE NOP
  100.                END
  101.             END
  102.  
  103.             IF event.trm_class = 'TRMS_ACTION' THEN DO
  104.                SELECT
  105.                   WHEN event.trm_id = 2 THEN Call Write
  106.  
  107.                   WHEN event.trm_id = 4 THEN ende=1
  108.  
  109.                   WHEN event.trm_id = 101 THEN Call rtezrequest("Aus dem Makro-Paket:"||R||R||"FontCode V3.0 für FW"||R||"© 1998 Heiko Schröder","Danke für Ihre Registrierung.","Info","rt_pubscrname=FinalWriterPubScreen")
  110.                   WHEN event.trm_id = 103 THEN address command "run Multiview PUBSCREEN=FinalWriterPubScreen "||d2c(34)||HilfeVerz||"FontCode.guide"||d2c(34)
  111.                   WHEN event.trm_id = 104 THEN ende=1
  112.  
  113.                   OTHERWISE NOP
  114.                END
  115.             END
  116.          END
  117.  
  118.          IF event.trm_class = 'TRMS_CLOSEWINDOW' THEN ende=1
  119.       END
  120.  
  121.       CALL TR_CLOSEPROJECT(window1)
  122.    END
  123.  
  124.    CALL TR_DELETEAPP(app)
  125. END
  126. ELSE
  127.    CALL quit('Kann das Fenster nicht öffnen',10)
  128.  
  129. Exit
  130.  
  131. Write:
  132.   a = TR_GETATTRIBUTE(window1,10,'TROB_String')
  133.   if a>15&a<256 then Type d2c(a)
  134. Return
  135. /*******************************************************************************
  136. ** Routine, die bei einer Unterbrechung des Scripts aufgerufen wird
  137. *******************************************************************************/
  138.  
  139. SYNTAX:
  140.    CALL quit('Fehler' rc 'in Zeile' sigl '-' ERRORTEXT(rc)||R||SOURCELINE(sigl)||R||'Bitte informieren Sie den Autor...',20)
  141.  
  142.  
  143. /*******************************************************************************
  144. ** Script beenden
  145. *******************************************************************************/
  146.  
  147. quit:
  148.    PARSE ARG message,rcode
  149.  
  150.    IF app ~= '00000000'x THEN DO
  151.       IF message ~= '' THEN
  152.          ret=rtezrequest(message,"_Okay","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  153.  
  154.       CALL TR_DELETEAPP(app)
  155.    END
  156.    ELSE DO
  157.       IF message ~= '' THEN DO
  158.          SAY message
  159.          SAY
  160.          OPTIONS PROMPT 'Bitte <RETURN> drücken'
  161.          PULL taste
  162.       END
  163.    END
  164.    Address command "C:FlushTRX All >NIL:"
  165.  
  166.    EXIT(rcode)
  167.